home *** CD-ROM | disk | FTP | other *** search
/ Mac Magazin/MacEasy 34 / Mac Magazin and MacEasy Magazine CD - Issue 34.iso / Grafik & Text / Alpha ƒ / Tcl / SystemCode / modes.tcl < prev    next >
Text File  |  1997-04-02  |  28KB  |  996 lines
  1. # (nowrap)
  2. # New modes can be specified by appending to the following vars. (nowrap)
  3. # are no longer any procs such as 'setTextMode' etc.
  4.  
  5.  
  6.  
  7. #================================================================================
  8. # The next two procs are called by Alpha to handle the mode flags popup menu.
  9. #================================================================================
  10.  
  11. proc getModeValuesAlpha {} {
  12.     global showInvisibles
  13.     
  14.     getWinInfo blah
  15.     lappend m "Mac" [expr {$blah(platform) == "mac"}]
  16.     lappend m "UNIX" [expr {$blah(platform) == "unix"}]
  17.     lappend m "IBM" [expr {$blah(platform) == "ibm"}] {(-} 0
  18.     lappend m "MPW" [expr {$blah(state) == "mpw"}]
  19.     lappend m "Think" [expr {$blah(state) == "think"}]
  20.     lappend m "None" [expr {$blah(state) == "none"}] {(-} 0
  21.     lappend m "Read Only" $blah(read-only)
  22.     lappend m "Show Invisibles" $showInvisibles {(-} 0
  23.     lappend m "Tab Size" 0
  24.     return $m
  25. }
  26.  
  27.  
  28. proc setModeVarAlpha {var} {
  29.     global mode allFlags modeVars modifiedModeVars
  30.     global ${mode}modeVars
  31.     
  32.     set var [string tolower $var]
  33.     switch $var {
  34.         "unix"      -
  35.         "mac"       -
  36.         "ibm"       { setWinInfo platform $var }
  37.         "mpw"       -
  38.         "think"     -
  39.         "none"      { setWinInfo state $var }
  40.         "tab size"  {
  41.             getWinInfo arr
  42.             if {![catch {prompt "New tab size?" $arr(tabsize)} res]} {
  43.                 setWinInfo tabsize $res
  44.             }
  45.         }
  46.         "read only" { 
  47.             getWinInfo b
  48.             setWinInfo read-only [expr -1 * ($b(read-only) - 1)]}
  49.         "show invisibles" { 
  50.             global showInvisibles
  51.             set showInvisibles [expr 1 - $showInvisibles]
  52.         }
  53.     }
  54.     return
  55. }
  56.  
  57. proc modeOptions {menu var} {
  58.     if {![llength [winNames]]} {
  59.         alertnote "No window!"
  60.         return
  61.     }
  62.     switch $var {
  63.         "flags"         modifyModeFlags
  64.         "menus"         setModeMenus
  65.         "editPrefs"     editCurrentModePrefs
  66.         "loadPrefs"     sourceCurrentModePrefs
  67.         "describeMode"  describeMode
  68.         "change"        changeModeDialog
  69.     }
  70. }
  71.  
  72. #===============================================================================
  73.  
  74. proc changeModeDialog {} {
  75.     global mode modeMenus
  76.     
  77.     set nmode [listpick -p "Mode:" -L $mode [lsort -ignore [array names modeMenus]]]
  78.     newMode $nmode
  79. }
  80.  
  81. #================================================================================
  82.  
  83. # Can be used to add new mode-specific flags and variables (see think.tcl for example).
  84. proc newModeVar {mode var val isFlag} {
  85.     global ${mode}modeVars modeVars allFlags $var
  86.     
  87.     if {![info exists modeVars] || [lsearch $modeVars $var] < 0} {
  88.         lappend modeVars $var
  89.     }
  90.     if {![info exists ${mode}modeVars($var)]} {
  91.         set ${mode}modeVars($var) $val
  92.         if {![info exists $var]} {
  93.             set $var $val
  94.         }
  95.     }
  96.     if {$isFlag && (![info exists allFlags] || ([lsearch $allFlags $var] < 0))} {
  97.         lappend allFlags $var
  98.     }
  99. }
  100.  
  101. #================================================================================
  102.  
  103. proc stringColorProc {flag} {
  104.     global $flag mode
  105.     
  106.     if {[set $flag] == "none"} {
  107.         set $flag "foreground"
  108.     }
  109.     if {$flag == "stringColor"} {
  110.         regModeKeywords -a -s $stringColor $mode
  111.     } elseif {$flag == "commentColor"} {
  112.         regModeKeywords -a -c $commentColor $mode
  113.     } elseif {$flag == "funcColor"} {
  114.         regModeKeywords -a -f $funcColor $mode
  115.     } elseif {$flag == "bracesColor"} {
  116.         regModeKeywords -a -I $bracesColor $mode
  117.     } elseif {($flag == "keywordColor") || ($flag == "sectionColor")} {
  118.         alertnote "Change in keyword color will take effect after Alpha restarts."
  119.         return
  120.     }
  121.     centerRedraw
  122. }
  123.  
  124. #================================================================================
  125.  
  126. proc saveVarValues {} {
  127.     global HOME modeMenus
  128.     if {[askyesno "Save variables and values to \"$HOME:alphaFlags.tcl\"?"] == "yes"} {
  129.         set lines {}
  130.         foreach m [lsort -ignore [array names modeMenus]] {
  131.             global ${m}modeVars
  132.             
  133.             if {[info exists ${m}modeVars]} {
  134.                 foreach v [array names ${m}modeVars] {
  135.                     append lines "set ${m}modeVars($v)\t\t\{[set ${m}modeVars($v)]\}\r"
  136.                 }
  137.                 append lines "\r"
  138.             }
  139.         }
  140.         
  141.         append lines "\r\r"
  142.         global allFlags allVars
  143.         set vars [lsort [concat $allFlags $allVars]]
  144.         eval global $vars
  145.         foreach f $vars {
  146.             append lines "set $f\t\t\{[set $f]\}\r"
  147.         }
  148.  
  149.         set fd [open "$HOME:alphaFlags.tcl" "w"]
  150.         puts $fd $lines
  151.         close $fd
  152.         message "New '$HOME:alphaFlags.tcl' written."
  153.     }
  154. }
  155.  
  156. #================================================================================
  157.  
  158. proc setWinMode name {
  159.     global winModes ModeSuffixes
  160.     set nm [file tail $name]
  161.     if {[set first [string last " <" $nm]] >= 0} {
  162.         set rname [string range $nm 0 [expr $first - 1]]
  163.     } else {
  164.         set rname $nm
  165.     }
  166.     case $rname in $ModeSuffixes
  167.     set winModes($name) $winMode
  168. }
  169.  
  170.  
  171. # Called from alphs in response to the mode popup.
  172. proc newMode mode {
  173.     global winModes modeProcs
  174.     
  175.     changeMode $mode
  176.     if {[catch {car [winNames -f]} name]} return
  177.     set winModes($name) $mode
  178.     centerRedraw
  179. }
  180.  
  181.  
  182. proc deactivateHook name {
  183. }
  184.  
  185. proc suspendHook name {
  186.     global iconifyOnSwitch
  187.     global suspIconed
  188.     if {$iconifyOnSwitch} {
  189.         set wins [winNames -f]
  190.         set suspIconed ""
  191.         foreach win $wins {
  192.             if {![icon -f "$win" -q]} {
  193.                 lappend suspIconed $win
  194.                 icon -f "$win" -t
  195.             }
  196.         }
  197.         set suspIconed [lreverse $suspIconed]
  198.     }
  199. }
  200.  
  201.  
  202. set killCompilerErrors 0
  203.  
  204. proc resumeHook name {
  205.     global iconifyOnSwitch resumeRevert suspIconed killCompilerErrors
  206.  
  207.     if {$killCompilerErrors} {
  208.         set wins [winNames -f]
  209.         if {[set res [lsearch $wins "*Compiler Errors*"]] >= 0} {
  210.             bringToFront [lindex $wins $res]
  211.             killWindow
  212.         }
  213.     }
  214.     
  215.     if {$iconifyOnSwitch && [info exists suspIconed]} {
  216.         set wins [winNames -f]
  217.         foreach win $suspIconed {
  218.             icon -f "$win" -o
  219.         }
  220.         unset suspIconed
  221.     }
  222.     if {$resumeRevert} {
  223.         set resumeRevert 0
  224.         revert
  225.     }
  226. }
  227.  
  228.  
  229.  
  230. # Handles dynamically adding and deleting window names from menu.
  231. proc addWinName name {
  232.     global winNameToNum winMenu winNumToName
  233.     
  234.     for {set i 0} {$i<100} {incr i} {
  235.         if ![info exists winNumToName($i)] {
  236.             regexp {(^\* .*|[^:]*$)} $name nm
  237.             if {$i < 10} {
  238.                 addMenuItem -m -l "/$i" $winMenu "$nm"
  239.             } else {
  240.                 addMenuItem -m -l "" $winMenu "$nm"
  241.             }
  242.             set winNumToName($i) $name
  243.             set winNameToNum($name) $i
  244.             return
  245.         }
  246.     }
  247. }
  248.  
  249. proc removeWinName name {
  250.     global winNameToNum winNumToName winMenu
  251.     regsub -all {\\([][])} $name {\1} name
  252.     set num $winNameToNum($name)
  253.     unset winNumToName($num)
  254.     unset winNameToNum($name)
  255.     regexp {(^\* .*|[^:]*$)} $name nm
  256.     deleteMenuItem -m $winMenu $nm
  257. }
  258.  
  259.  
  260. proc menuWin {menu name} {
  261.     global winNameToNum
  262.  
  263.     set nms [array names winNameToNum]
  264.  
  265.     if {[lsearch $nms "*[quoteExpr $name]"] < 0} {
  266.         $name
  267.         return
  268.     }
  269.  
  270.     foreach nm $nms {
  271.         if {[string match *[quoteExpr $name] $nm] == "1"}  {
  272.             bringToFront $name
  273.             if [icon -q] { icon -f $name -o }
  274.             return
  275.         }
  276.     }
  277.     return "normal"
  278. }
  279.  
  280.  
  281. # Do not move 'displayMode' calls!
  282. proc changeMode {newMode} {
  283.     global lastMode modeMenus dummyProc mode seenMode PREFS globalMenus_curr
  284.     
  285.     set lastMode $mode
  286.     set mode $newMode
  287.     if {$lastMode == $mode} {
  288.         catch {displayMode $newMode}
  289.         return
  290.     }
  291.     global ${lastMode}modeVars
  292.  
  293. #     if {[info exists ${lastMode}modeVars]} {
  294. #         foreach v [array names ${lastMode}modeVars] {
  295. #             global $v
  296. #             catch {unset $v}
  297. #         }
  298. #     }
  299.  
  300.     floatShowHide off $lastMode
  301.     
  302.     # Used to be after the modeVar stuff. Why?
  303.     if {[info exists dummyProc($mode)]} { $dummyProc($mode) }
  304.  
  305.     global ${mode}modeVars
  306.     if {[info exists ${mode}modeVars]} {
  307.         foreach v [array names ${mode}modeVars] {
  308.             global $v
  309.             set $v [set ${mode}modeVars($v)]
  310.         }
  311.     }
  312.  
  313.     if {[info exists modeMenus($lastMode)]} {
  314.         if {[info exists modeMenus($mode)]} {
  315.             set oldMenus modeMenus($mode)
  316.         } else {
  317.             set oldMenus ""
  318.         }
  319.         foreach m $modeMenus($lastMode) {
  320.             if {([lsearch $globalMenus_curr $m] < 0) && ([lsearch $oldMenus $m] < 0)} {
  321.                 global $m
  322.                 catch {removeMenu [set $m]}
  323.             }
  324.         }
  325.     }
  326.     if {[info exists modeMenus($mode)]} {
  327.         foreach m $modeMenus($mode) {
  328.             catch {$m}
  329.             global $m
  330.             catch {insertMenu [set $m]}
  331.         }
  332.     }
  333.     
  334.     if {![info exists seenMode($mode)]} {
  335.         if {($mode != "") && [file exists "$PREFS:${mode}Prefs.tcl"]} {
  336.             if {[catch {source "$PREFS:${mode}Prefs.tcl"}]} {
  337.                 alertnote "Your preferences file '${mode}Prefs.tcl has an error."
  338.             } else {
  339.                 set seenMode($mode) 1
  340.             }
  341.         }
  342.     }
  343.     floatShowHide on $mode
  344.         
  345.     catch {displayMode $newMode}
  346. }
  347.  
  348.  
  349. proc setModeMenus {} {
  350.     global mode modeMenus menus modifiedModeMenus globalMenus_curr
  351.  
  352.     set ms [listpick -p "Pick menus for mode '$mode':" -l -L $modeMenus($mode) [lsort $menus]]
  353.     set modeMenus($mode) $ms
  354.  
  355.     lappend modifiedModeMenus $mode
  356.  
  357.     foreach m $menus {
  358.         if {[lsearch $globalMenus_curr $m] < 0} {
  359.             global $m
  360.             catch {removeMenu [set $m]}
  361.         }
  362.     }
  363.  
  364.     foreach m $ms {
  365.         global $m
  366.         catch {$m}
  367.         catch {insertMenu [set $m]}
  368.     }
  369. }
  370.  
  371.  
  372. #=============================================================================
  373. # Hook procs recognized: "openHook", "closeHook", "activateHook", "deactivateHook", 
  374. #                        "suspendHook", "saveasHook", "saveHook", and "resumeHook".
  375. #=============================================================================
  376.  
  377. if {![info exists winActive]} {set winActive ""}
  378.  
  379. # Event hooks - set specific modes when files opened.
  380.  
  381.  
  382. proc openHook name {
  383.     global winModes autoMark mode screenHeight screenWidth forceMainScreen recentFiles recentFilesCount 
  384.  
  385.     changeMode $winModes($name)
  386.     if {$name == {*Toolserver shell*}} startMPW
  387.     regsub -all {\\([][])} $name {\1} nm
  388.     addWinName $nm
  389.     message ""
  390.  
  391.     if {![catch {getFileInfo $name info}]} {
  392.         if {$info(creator) == {ttxt}} {
  393.             setWinInfo dirty 0
  394.         }
  395.         if {$info(type) == {ttro}} {
  396.             catch {setWinInfo read-only 1}
  397.             message "Read-only!"
  398.         }
  399.     }
  400.  
  401.     global ${mode}modeVars
  402.     
  403.     if {$forceMainScreen} {
  404.         set geo [getGeometry]
  405.         set l [lindex $geo 0]; set t [lindex $geo 1]; set w [lindex $geo 2]; set h [lindex $geo 3]; 
  406.         if {($l < 0) || ($t < 35) || ([expr $l + $w] > $screenWidth) || ([expr $t + $h + 18] > $screenHeight)} {
  407.             singlePage
  408.         }
  409.     }
  410.     getWinInfo arr
  411.     if {[info exists ${mode}modeVars(autoMark)] && [set ${mode}modeVars(autoMark)] && !$arr(read-only) && ![llength [getNamedMarks -n]]} {
  412.         markFile
  413.     }
  414.     
  415.     if {[string match "*Preferences*defs.tcl" $name]} {setWinInfo read-only 1}
  416.     
  417.     pushRecent $name 
  418. }
  419.  
  420.  
  421. # full pathname, called *before* file actually saved
  422. proc saveHook name {
  423.     global backup backExtension backDir mode winModes
  424.     
  425.     if {($mode == "C") || ($mode == "Pasc") || ($mode == "C++")} {catch {modified}}
  426.  
  427.     if {$winModes($name) == "HTML"} {catch {htmlLastModified $name}}
  428.  
  429.     if ($backup) {
  430.         set dir [uplevel #0 {substituteVars $backDir}]
  431.             
  432.         if {![string length $dir]} {
  433.             set dir [file dirname $name]
  434.         }
  435.         if {![file exists $dir]} {
  436.             if {[askyesno "Create backup dir '$dir'?"] == "yes"} {
  437.                 mkdir $dir
  438.             }
  439.         }
  440.         catch {rm $dir:[file tail $name]$backExtension}
  441.         catch {cp $name $dir:[file tail $name]$backExtension}
  442.     }
  443. }
  444.  
  445.  
  446. # full pathname, called *after* file saved.
  447. proc savePostHook name {
  448.     global savePostHooks
  449.     
  450.     if {[info exists savePostHooks]} {
  451.         foreach hook $savePostHooks {
  452.             catch {$hook $name}
  453.         }
  454.     }
  455. }
  456.  
  457.  
  458. proc revertToBackup {} {
  459.     global backup backExtension backDir winModes 
  460.  
  461.     set fname [car [winNames -f]]
  462.     set dir [uplevel #0 {substituteVars $backDir}]
  463.     set bname "$dir:[file tail $fname]$backExtension"
  464.     if {![file exists $bname]} {
  465.         message "Backup file '$bname' does not exist"
  466.         return
  467.     }
  468.     
  469.     if {[askyesno "Revert to backup dated '[join [mtime [file mtime $bname]]]'?"] == "yes"} {
  470.         killWindow
  471.         
  472.         edit $bname
  473.         saveAs -f $fname
  474.     }
  475. }
  476.  
  477.  
  478.  
  479. # Clean up the mark stack.
  480. proc closeHook name {
  481.     global markStack winModes winActive
  482.  
  483.     unset winModes($name)
  484.     if [llength $markStack] {
  485.         set markStack [removePat $markStack $name*]
  486.     }
  487.     removeWinName $name
  488.  
  489.     if {[set ind [lsearch $winActive $name]] >= 0} {
  490.         set winActive [lreplace $winActive $ind $ind]
  491.     }
  492.  
  493.     catch {unset winModes($name)}
  494.  
  495.     if {![llength [winNames]]} {
  496.         changeMode {}
  497.     }
  498. }
  499.  
  500.  
  501. proc saveasHook {oldName newName} {
  502.     global winModes winActive
  503.     if {$oldName == $newName} return
  504.     removeWinName $oldName
  505.     addWinName $newName
  506.     setWinMode $newName
  507.     changeMode $winModes($newName)
  508.     
  509.     pushRecent $newName
  510.     
  511.     if {$winModes($newName) == "HTML"} {catch {htmlLastModified $newName}}
  512.  
  513.     if {[set ind [lsearch $winActive $oldName]] >= 0} {
  514.         set winActive [lreplace $winActive $ind $ind]
  515.     }
  516.     set winActive [linsert $winActive 0 $newName]
  517.     catch {unset winModes($oldName)}
  518. }
  519.  
  520. if {![info exists actives]} {set actives 0}
  521.  
  522. # and, install a new 'winActive' patch , to 'activateHook':
  523.  
  524. proc activateHook name {
  525.     global winModes winActive
  526.  
  527.     if {![info exists winModes($name)]} {
  528.         setWinMode $name
  529.     }
  530.     changeMode $winModes($name)
  531.  
  532.     if {[set ind [lsearch $winActive $name]] == -1} {
  533.         set winActive [linsert $winActive 0 $name]
  534.         return
  535.     }
  536.     if {$ind >= 1} {
  537.         set winActive [lreplace $winActive $ind $ind]
  538.         set winActive [linsert $winActive 0 $name]
  539.     }
  540.  
  541. }
  542.  
  543.  
  544. proc dirtyHook {name dirty} {
  545.     global winMenu
  546.     markMenuItem $winMenu [file tail $name] $dirty "◊"
  547. }
  548.  
  549.  
  550. proc quitHook {} {
  551.     global quitHooks PREFS
  552.     if {[file exists "$PREFS:ftpTmp"]} {
  553.         catch {rm "$PREFS:ftpTmp:*"}
  554.     }
  555.     saveModifiedVars
  556.     if {[info exists quitHooks]} {
  557.         foreach item $quitHooks {
  558.             $item
  559.         }
  560.     }
  561. }
  562.  
  563.  
  564. proc saveModifiedVars {} {
  565.     global modifiedVars modifiedModeVars modifiedArrVars modifiedModeMenus modeMenus prefDefs recentFilesSave recentFiles
  566.  
  567.     if {[llength $modifiedVars] || [llength $modifiedArrVars] || [llength $modifiedModeVars] || [llength $modifiedModeMenus]} {
  568.         foreach f [removeDups $modifiedModeMenus] {
  569.             addArrDef modeMenus $f $modeMenus($f)
  570.         }
  571.         foreach f [removeDups $modifiedArrVars] {
  572.             global $f
  573.             foreach ind [array names $f] {
  574.                 addArrDef $f $ind [set ${f}($ind)]
  575.             }
  576.         }
  577.         foreach f [removeDups $modifiedVars] {
  578.             global $f
  579.             addDef $f [set $f]
  580.         }
  581.         foreach f [removeDups $modifiedModeVars] {
  582.             set nm [lindex $f 0]
  583.             set mode [lindex $f 1]
  584.             global $mode
  585.             addArrDef [set mode] $nm [set [set mode]($nm)]
  586.         }
  587.     }
  588.     
  589.     if {[info exists recentFiles]} {
  590.         addDef recentFilesSave $recentFiles
  591.     }
  592.  
  593.     set modifiedVars {}
  594.     set modifiedArrVars {}
  595.     set modifiedModeVars {}
  596.     set modifiedModeMenus {}
  597. }
  598.  
  599. #================================================================================
  600.  
  601. proc describeMode {} {
  602.     global mode ModeSuffixes modeMenus
  603.     global ${mode}modeVars
  604.     
  605.     set text "\r\tMODE $mode\r\r"
  606.     set suffs ""
  607.     set first 1
  608.     foreach suf $ModeSuffixes {
  609.         if {([llength $suf] == 3) && ([lindex $suf 1] == "winMode") && ([lindex $suf 2] == $mode)} {
  610.             if {$first} {
  611.                 lappend suffs $last
  612.                 set first 0
  613.             } else {
  614.                 append suffs ", $last"
  615.             }
  616.         }
  617.         set last $suf
  618.     }
  619.     append text "Mode filepats: $suffs\r\r"
  620.     
  621.     set first 1
  622.     append text "Mode menus: "
  623.     if {[info exists modeMenus($mode)]} {
  624.         foreach m $modeMenus($mode) {
  625.             if $first {
  626.                 set first 0
  627.                 lappend text $m
  628.             } else {
  629.                 append text ", $m"
  630.             }
  631.         }
  632.     }
  633.     append text "\r\r"
  634.  
  635.     append text "Mode-specific variables:\r"
  636.     if {[info exists ${mode}modeVars]} {
  637.         foreach v [lsort [array names ${mode}modeVars]] {
  638.             append text [format "\t%-20s: \"%s\"\r" $v [set ${mode}modeVars($v)]]
  639.         }
  640.     }
  641.  
  642.  
  643.     set etext "\rMode-independent bindings:\r"
  644.     append text "\rMode-specific bindings:\r"
  645.     foreach b [split [bindingList] "\r"] {
  646.         set lst [lindex $b end]
  647.         if {$lst == $mode} {
  648.             append text "\t$b\r"
  649.         } elseif {[lsearch [lsort -ignore [array names modeMenus]] $lst] < 0} {
  650.             append etext "\t$b\r"
  651.         }
  652.     }
  653.     new -n "* <$mode> MODE *"
  654.     insertText $text$etext
  655.     goto 0
  656.     
  657.     setWinInfo dirty 0
  658. }
  659.  
  660.  
  661. proc globalOptions {menu item {is_mode ""}} {
  662.     global flagPrefs varPrefs maxT tcl_var_procs modifiedVars modeMenus mode
  663.  
  664.     updateMisc
  665.     if {[string length $is_mode]} {
  666.         set args {}
  667.         set nvars [llength $item]
  668.         for {set i 0} {$i < $nvars} {incr i 10} {
  669.             lappend args [list "Page [expr 1+(${i}/10)] of ${is_mode}" $menu [lrange $item $i [expr $i+9]]]
  670.             set menu ""
  671.         }
  672.             
  673.     } else {
  674.         if {$item == "menus"} {
  675.             global menus globalMenus_curr
  676.             
  677.             set globalMenus_curr [listpick -p "Select global menus:" -l -L $globalMenus_curr  [lsort -ignore $menus]]
  678.             foreach m $menus {
  679.                 global $m
  680.                 if {[info exists $m]} {
  681.                     catch "removeMenu [set $m]"
  682.                 }
  683.             }
  684.             lappend    modifiedVars globalMenus_curr
  685.             foreach    m $globalMenus_curr    {
  686.                 catch $m
  687.                 insertMenu [set    $m]
  688.             }
  689.             if {[info exists modeMenus($mode)]}    {
  690.                 foreach    m $modeMenus($mode)    {
  691.                     catch $m
  692.                     insertMenu [set    $m]
  693.                 }
  694.             }
  695.             return
  696.         }
  697.         if {$item != "flags"} {
  698.             return [$item]
  699.         }
  700.         
  701.         set args {}
  702.         foreach nm [array names flagPrefs] {
  703.             lappend args [list $nm $flagPrefs($nm) $varPrefs($nm)]
  704.         }
  705.     }
  706.     
  707.     set left 20
  708.     
  709.     set height [expr 500 + 60]
  710.  
  711.     set names {}
  712.     set maxT 0
  713.     foreach arg [lsort $args] {
  714.         if {[llength $arg] != 3} {error "Bad structure"}
  715.         lappend names [lindex $arg 0]
  716.         set flags [lindex $arg 1]
  717.         set vars [lindex $arg 2]
  718.         append editItems " " $flags " " $vars
  719.         append cmd " -n \{[lindex $arg 0]\} " [dialSet $flags $vars]
  720.     }
  721.  
  722.     set height [expr $maxT + 30]
  723.     set buttons [concat -b OK $left [expr $height-30] [expr $left + 60] [expr $height-10] -b Cancel [expr $left + 100] [expr $height-30] [expr $left + 160] [expr $height-10]]
  724.     global blah
  725.     set res [eval [concat dialog -w 480 -h $height -t "Preferences:" 60 10 140 30 $buttons [list -m [concat [list [lindex $names 0]] $names] 150 10 405 30]  $cmd]]
  726.  
  727.     set changed {}
  728.     
  729.     if {[lindex $res 0]} {
  730.         set res [lrange $res 3 end]
  731.         
  732.         if {[string length $is_mode]} {
  733.             return $res
  734.         }
  735.         
  736.         foreach item $editItems {
  737.             set val [lindex $res 0]
  738.             set res [lrange $res 1 end]
  739.             
  740.             global $item
  741.             if {[set $item] != $val} {
  742.                 set $item $val
  743.                 if {[info exists tcl_var_procs($item)]} {
  744.                     $tcl_var_procs($item) $item
  745.                 }
  746.                 lappend modifiedVars $item
  747.             }
  748.         }
  749.     } else {
  750.         error "Cancel chosen"
  751.     }
  752. }
  753.  
  754.  
  755. proc modifyModeFlags {{title ""}} {
  756.     global mode invisibleModeVars modifiedModeVars
  757.     global ${mode}modeVars
  758.     global allFlags tcl_var_procs
  759.     global ${mode}invisibleModeVars
  760.  
  761.     if {$mode == ""} {
  762.         alertnote "No mode set!"
  763.         return
  764.     }
  765.     if {$title == ""} {
  766.         set title "Preferences for '${mode}' mode"
  767.     }
  768.     # check for mode specific proc
  769.     if {[info commands ${mode}modifyFlags] != ""} {${mode}modifyFlags; return}
  770.     
  771.     set flags {}
  772.     set vars {}
  773.     
  774.     if {[info exists ${mode}modeVars]} {
  775.  
  776.         foreach v [lsort [array names ${mode}modeVars]] {
  777.             if {[info exists invisibleModeVars($v)] \
  778.             || [info exists ${mode}invisibleModeVars($v)]} continue
  779.             
  780.             if {[lsearch $allFlags $v] >= 0} {
  781.                 lappend flags $v
  782.             } else {
  783.                 lappend vars $v
  784.             }
  785.         }
  786.         set flags [lsort $flags]
  787.         set vars [lsort $vars]
  788.         
  789.         if {[llength $vars] > 10 } {
  790.             set res [globalOptions $flags $vars $title]
  791.         } else {
  792.             set res [modeDialog $flags $vars $title]
  793.         }
  794.         
  795.         foreach flag [concat $flags $vars] {
  796.             global $flag
  797.             set val [lindex $res 0]
  798.             set res [lrange $res 1 end]
  799.             
  800.             if {[set $flag] != $val} {
  801.                 set $flag $val
  802.                 set ${mode}modeVars($flag) $val
  803.                 lappend modifiedModeVars [list $flag ${mode}modeVars]
  804.  
  805.                 if {[info exists tcl_var_procs($flag)]} {
  806.                     $tcl_var_procs($flag) $flag
  807.                 }
  808.             }
  809.         }
  810.         updateSuffixes
  811.     }
  812. }
  813.  
  814. proc modifyModeString {flag} {
  815.     global stringColor mode
  816.     
  817.     regModeKeywords -a -s $stringColor $mode
  818.     centerRedraw
  819. }
  820.  
  821. # Suffixes used to initially determine mode for new window.
  822. proc updateSuffixes {} {
  823.     global ModeSuffixes modeMenus filepats
  824.  
  825.     set ModeSuffixes { default { set winMode Text } }
  826.     foreach m [lsort -ignore [array names modeMenus]] {
  827.         if {[info exists filepats($m)]} {
  828.             lappend ModeSuffixes $filepats($m) "set winMode $m"
  829.         }
  830.     }
  831. }
  832.  
  833. #===============================================================================
  834. proc addMode {m dummy suffs menus} {
  835.     global dummyProc modeMenus filepats
  836.     
  837.     set modeMenus($m) $menus
  838.     if {[string length $dummy]} {set dummyProc($m) $dummy}
  839.     set filepats($m) $suffs
  840. }
  841.  
  842.  
  843. proc addMenu {m} {
  844.     global menus
  845.     if { ![info exists menus] || [lsearch -exact $menus $m] == -1 } {
  846.         lappend menus $m
  847.     }
  848. }
  849.  
  850.  
  851. #===============================================================================
  852.  
  853. ####################################
  854. #                                   #
  855. #    A Few Small    Mode Definitions   #
  856. #                                   #
  857. ####################################
  858.  
  859. if !$alphaLite {
  860.     addMode MPW {} {"*Toolserver\ *"} {}
  861.     addMode Diff {} {} {}
  862.  
  863.     addMode PS {} {*.ps} {}
  864.     newModeVar PS prefixString {% } 0 
  865.     set PSKeyWords {
  866.         def begin end dict load
  867.         exec if ifelse for repeat loop exit stop stopped countexecstack execstack quit start
  868.         gsave grestore grestoreall initgraphics 
  869.         newpath erasepage fill eofill stroke image imagemask showpage copypage
  870.     }
  871.     if {[info exists PSwords]} {set PSKeyWords [concat $PSKeyWords $PSwords]}
  872.     regModeKeywords -e {%} -m {/}  -c red -k blue PS $PSKeyWords -i "\}" -i "\{" -i {[} -i {]} -I green
  873.     unset PSKeyWords
  874. }
  875.  
  876. #================================================================================
  877. addMode Brws dummyBrws {} {}
  878. #================================================================================
  879. addMode Text {} {default} {}
  880. newModeVar Text leftFillColumn {0} 0
  881. newModeVar Text suffixString { <--} 0
  882. newModeVar Text prefixString {> } 0
  883. newModeVar Text fillColumn {75} 0
  884. newModeVar Text wordWrap {1} 1
  885. newModeVar Text wordBreak {\w+} 0
  886. newModeVar Text wordBreakPreface {(\W)} 0
  887. newModeVar Text wrapBreak {[\w_]+} 0
  888. newModeVar Text wrapBreakPreface {([^\w_])} 0
  889. newModeVar Text autoMark    0   1
  890.  
  891. ##############################
  892. #                             #
  893. #    Things done    at startup     #
  894. #                             #
  895. ##############################
  896.  
  897. # For quithook
  898. set modifiedVars        {}
  899. set modifiedArrVars     {}
  900. set modifiedModeVars    {}
  901. set modifiedModeMenus   {}
  902.  
  903. # ???
  904. set modeVars             {funcExpr wrapBreakPreface wrapBreak wordBreakPreface wordBreak}
  905.  
  906. # 'mode' is nothing when we start up.
  907. set mode                 {}
  908. set lastMode            0
  909. set reverting             {}
  910.  
  911. # Used on modified mode flags.
  912. set tcl_var_procs(stringColor) "stringColorProc"
  913. set tcl_var_procs(commentColor) "stringColorProc"
  914. set tcl_var_procs(keywordColor) "stringColorProc"
  915. set tcl_var_procs(funcColor) "stringColorProc"
  916. set tcl_var_procs(sectionColor) "stringColorProc"
  917. set tcl_var_procs(bracesColor) "stringColorProc"
  918.  
  919.  
  920. ##############################################################
  921. #                                                             #
  922. #    Used to    split flags    over different preferences panels.     #
  923. #                                                             #
  924. ##############################################################
  925. set flagPrefs(Backups)         {backup}
  926. set varPrefs(Backups)         {backDir backExtension}
  927. set flagPrefs(Gui)             {blinkingCursor blockCursor coloring dragAndDrop iconifyOnSwitch intelCutPaste lockStatus showInvisibles smallMenuFont sortFuncsMenu tearoffMenus } 
  928. set varPrefs(Gui)              {defaultFont fontSize tabSize}
  929. set flagPrefs(Printer)         {printHeader printHeaderFullPath printHeaderTime}
  930. set varPrefs(Printer)         {bottomMargin printerFont printerFontSize topMargin leftMargin}
  931. set flagPrefs(Tags)         {}
  932. set varPrefs(Tags)             {funcPar tagFile}
  933. set flagPrefs(Window)         {autoHScroll forceMainScreen horScrollBar moveInsertion powerThumb sortedIsDefault}
  934. set varPrefs(Window)         {defHeight defLeft defTop defWidth }
  935. set flagPrefs(Tiling)         {}
  936. set varPrefs(Tiling)         {numWinsToTile horMargin tileHeight tileProportion tileLeft tileMargin tileTop tileWidth }
  937. set flagPrefs(Wrapping)     {}
  938. set varPrefs(Wrapping)         {fillColumn leftFillColumn paraColumn wrapLow wrapHigh}
  939.  
  940. proc updateMisc {} {
  941.     uplevel #0 {
  942.         set flagPrefs(Miscellaneous) {}
  943.         foreach f $allFlags {
  944.             if {([lsearch $modeVars $f] < 0) && ([lsearch $flagPrefs(Tiling) $f] < 0) && ([lsearch $flagPrefs(Backups) $f] < 0) && ([lsearch $flagPrefs(Gui) $f] < 0) && ([lsearch $flagPrefs(Printer) $f] < 0) && ([lsearch $flagPrefs(Tags) $f] < 0) && ([lsearch $flagPrefs(Window) $f] < 0) && ([lsearch $flagPrefs(Wrapping) $f] < 0)} {
  945.                 lappend flagPrefs(Miscellaneous) $f
  946.             }
  947.         }
  948.         
  949.         set varPrefs(Miscellaneous) {}
  950.         foreach f $allVars {
  951.             if {([lsearch $modeVars $f] < 0) && ([lsearch $varPrefs(Tiling) $f] < 0) && ([lsearch $varPrefs(Backups) $f] < 0) && ([lsearch $varPrefs(Gui) $f] < 0) && ([lsearch $varPrefs(Printer) $f] < 0) && ([lsearch $varPrefs(Tags) $f] < 0) && ([lsearch $varPrefs(Window) $f] < 0) && ([lsearch $varPrefs(Wrapping) $f] < 0)} {
  952.                 lappend varPrefs(Miscellaneous) $f
  953.             }
  954.         }
  955.     }
  956. }
  957.  
  958.  
  959. #####################################################
  960. #                                                    #
  961. #    Find out which modes and menus are out there.    #
  962. #                                                    #
  963. #####################################################
  964.  
  965. set startingUp 1
  966. if {![catch {glob "$HOME:Tcl:Modes:*Mode.tcl"} files]} {
  967.     foreach f $files {
  968.         if {[catch {source $f}]} {
  969.             lappend problems [file tail $f]
  970.         }
  971.     }
  972. }
  973. if {![catch {glob "$HOME:Tcl:Menus:*Menu.tcl"} files]} {
  974.     foreach f $files {
  975.         if {[catch {source $f}]} {
  976.             lappend problems [file tail $f]
  977.         }
  978.     }
  979. }
  980. if {[info exists problems]} {
  981.     alertnote "Problems loading files '$problems'"
  982.     unset problems
  983. }
  984. if {[info exists menus]} {
  985.     set menus [removeDups $menus]
  986. }
  987. set startingUp 0
  988.  
  989. foreach    m [lsort -ignore [array names modeMenus]] {
  990.     addMenuItem    -m modePrefs $m
  991. }
  992.  
  993. addMode Text {} {} {}
  994. updateSuffixes
  995.  
  996.